knitr::opts_chunk$set(echo=TRUE)
source("functions.R")
source("texts.R")
options(outDec=",",big.mark=".")
library(plotly)
## Carregando pacotes exigidos: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(flextable)
##
## Attaching package: 'flextable'
## The following objects are masked from 'package:plotly':
##
## highlight, style
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ purrr::compose() masks flextable::compose()
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
set_flextable_defaults(scroll=list())
# tabela unificada
df <- readRDS("pda_tiss_hosp_mini.rds")
# corrigindo valores ausentes
temp <- df[, c("VL_ITEM_EVENTO_INFORMADO", "VL_ITEM_PAGO_FORNECEDOR")]
temp[is.na(temp)] <- 0
df[, c("VL_ITEM_EVENTO_INFORMADO", "VL_ITEM_PAGO_FORNECEDOR")] <- temp
# dados com variaveis numericas de interesse agregadas por ocorrencia
aggnum_df <- df[,c(id_var, numeric_vars)] %>%
group_by(ID_EVENTO_ATENCAO_SAUDE) %>%
summarise(
VL_TOTAL_ITENS_INFORMADOS=sum(QT_ITEM_EVENTO_INFORMADO*VL_ITEM_EVENTO_INFORMADO),
VL_ITEM_PAGO_FORNECEDOR=sum(VL_ITEM_PAGO_FORNECEDOR),
TEMPO_DE_PERMANENCIA=max(TEMPO_DE_PERMANENCIA))
# dados com variaveis categoricas de interesse agregadas por ocorrencia
aggcat_df <- df[,c(id_var, categorical_vars)] %>%
group_by(ID_EVENTO_ATENCAO_SAUDE) %>%
summarise_at(categorical_vars, max) %>%
mutate(ANO_MES_EVENTO=zoo::as.yearmon(ANO_MES_EVENTO))
# tabela agregada
agg_df <- inner_join(aggcat_df, aggnum_df, by="ID_EVENTO_ATENCAO_SAUDE")
# dados para treinamento de modelo
tdf <- slice_sample(agg_df, prop=0.8)
# dados para avaliação de modelo
adf <- agg_df[!{agg_df$ID_EVENTO_ATENCAO_SAUDE %in% tdf$ID_EVENTO_ATENCAO_SAUDE},]
A Agência Nacional de Saúde Suplementar (ANS) é responsável por regular os planos de saúde no Brasil. Esta agência iniciou o Plano de Dados abertos (PDA), que consiste em solicitar dados para divulgação pública com diversos propósitos, desde o acesso à informação por parte do público como também para ajudar na regulação por parte do próprio órgão.
O PDA possui dados para internações e procedimentos hospitalares e ambulatoriais, mas nesta análise serão tratados apenas os dados de origem hospitalar. A análise realizada aqui é feita a partir de um recorte aleatório de dados do Padrão para Troca de Informação de Saúde Suplementar (TISS) para todos os estados do Brasil, mas apenas ao longo do ano de 2019. Nesta análise será observado o comportamento geral de todas as variáveis, além da extração de algum possível valor de negócio nestas informações.
Aqui serão considerados “Atendimento”, a junção de todos os procedimentos realizados no paciente (Ex.: exames, consultas, internações, remédios, etc.), desde a entrada até sua alta. Foram coletados os dados da tabela Consolidada, onde cada observação (linhas) corresponde a um atendimento, e da tabela Detalhada, onde as observações correspondem a cada um dos diferentes procedimentos adotados em cada atendimento hospitalar.
Como a tabela Detalhada apresenta múltiplas observações para cada atendimento
Estas duas tabelas foram unidas em apenas uma chamada Unificada, que repete as observações da tabela Consolidada ao longo de suas respectivas ocorrências na tabela Detalhada. Além disso, uma nova tabela foi criada aqui para análise, que será chamada de Agregada, que agrega a tabela unificada por ocorrência de atendimento.
# tabela unificada
df <- readRDS("pda_tiss_hosp_mini.rds")
# corrigindo valores ausentes
temp <- df[, c("VL_ITEM_EVENTO_INFORMADO", "VL_ITEM_PAGO_FORNECEDOR")]
temp[is.na(temp)] <- 0
df[, c("VL_ITEM_EVENTO_INFORMADO", "VL_ITEM_PAGO_FORNECEDOR")] <- temp
# dados com variaveis numericas de interesse agregadas por ocorrencia
aggnum_df <- df[,c(id_var, numeric_vars)] %>%
group_by(ID_EVENTO_ATENCAO_SAUDE) %>%
summarise(
VL_TOTAL_ITENS_INFORMADOS=sum(QT_ITEM_EVENTO_INFORMADO*VL_ITEM_EVENTO_INFORMADO),
VL_ITEM_PAGO_FORNECEDOR=sum(VL_ITEM_PAGO_FORNECEDOR),
TEMPO_DE_PERMANENCIA=max(TEMPO_DE_PERMANENCIA))
# dados com variaveis categoricas de interesse agregadas por ocorrencia
aggcat_df <- df[,c(id_var, categorical_vars)] %>%
group_by(ID_EVENTO_ATENCAO_SAUDE) %>%
summarise_at(categorical_vars, max) %>%
mutate(ANO_MES_EVENTO=zoo::as.yearmon(ANO_MES_EVENTO))
# tabela agregada
agg_df <- inner_join(aggcat_df, aggnum_df, by="ID_EVENTO_ATENCAO_SAUDE")
# dados para treinamento de modelo
tdf <- slice_sample(agg_df, prop=0.8)
# dados para avaliação de modelo
adf <- agg_df[!{agg_df$ID_EVENTO_ATENCAO_SAUDE %in% tdf$ID_EVENTO_ATENCAO_SAUDE},]
A primeira característica importante desta análise é a de que vamos focar na “independência” das variáveis. Muitos dados aqui dependem de referências externas, principalmente de dados de tabelas de classificação da Terminologia Unificada da Saúde Suplementar, e podem ajudar a fazer previsões ou recortes nos dados para determinadas características de atenção, como regime e causa do atendimento. Usando apenas os dados presentes aqui, muitas das possíveis soluções ficam inacessíveis, e portanto estas variáveis serão deixadas de lado.
Dentre as variáveis numéricas de maior interesse de negócio podem se incluir:
Embora com valores numéricos, a maioria das variáveis encontradas na tabela abaixo não são ordinais nem cardinais, ou seja, não podem ser comparadas pelo valor numérico (\(a>b\) não se aplica) nem são passíveis de operações aritméticas (não se pode dizer que \(a \times b\) será igual a \(ab\)) respectivamente.
As variáveis marcadas em negrito são as únicas em que estas propriedades mencionadas se aplicam, além de serem as mais indicadas de possuir valor de negócio independentemente. Abaixo, um resumo sobre todas as variáveis numéricas neste conjunto de dados:
temp <- ifelse({names(num_vars1) %in% det_vars}, "Detalhada", "Consolidada")
temp[1] <- "Unificada"
temp[21] <- "Agregada"
data.frame(Nome=names(num_vars1), Descrição=num_vars1, Tabela=temp) %>%
out_table() %>% bold(i=c(2, 4:6, 21))
Nome | Descrição | Tabela |
|---|---|---|
index | Índice de identificador da ocorrência, gerado após a coleta dos dados | Unificada |
TEMPO_DE_PERMANENCIA | Tempo de permanência no atendimento (dias) | Detalhada |
CD_TABELA_REFERENCIA | Identificador de procedimento/item utilizado | Detalhada |
QT_ITEM_EVENTO_INFORMADO | Quantidade utilizada do procedimento/item | Detalhada |
VL_ITEM_EVENTO_INFORMADO | Valor individual do procedimento/item identificado | Detalhada |
VL_ITEM_PAGO_FORNECEDOR | Valor total pago pela operadora do plano de saúde à fornecedora | Detalhada |
IND_PACOTE | Faz parte de um pacote de procedimentos. 1=Sim, 0=Não | Detalhada |
IND_TABELA_PROPRIA | Identificador do procedimento é próprio da operadora. 1=Sim, 0=Não | Detalhada |
ID_PLANO | Identificador único do plano de saúde, não segue regulamento da ANS | Consolidada |
CD_MUNICIPIO_BENEFICIARIO | Codigo de Municipio IBGE (residência do beneficiário) | Consolidada |
CD_MODALIDADE | Código numério identificando a operadora | Consolidada |
CD_MUNICIPIO_PRESTADOR | Codigo de Municipio IBGE (estabelecimento médico) | Consolidada |
CD_CARATER_ATENDIMENTO | Caráter do atendimento conforme tabela externa TUSS 23 | Consolidada |
CD_TIPO_INTERNACAO | Tipo de internação conforme tabela externa TUSS 57 | Consolidada |
CD_REGIME_INTERNACAO | Regime de internação conforme tabela externa TUSS 41 | Consolidada |
CD_MOTIVO_SAIDA | Motivo do encerramento do atendimento conforme tabela externa TUSS 39 | Consolidada |
QT_DIARIA_ACOMPANHANTE | Número de diárias de acompanhante | Consolidada |
QT_DIARIA_UTI | Número de diárias de UTI | Consolidada |
IND_ACIDENTE_DOENCA | Especifica tipo de acidente ou doença do usuário conforme tabela externa TUSS 36 | Consolidada |
LG_VALOR_PREESTABELECIDO | Indica se o valor é preestabelecido em contrato. 1=Sim, 2=Não | Consolidada |
VL_TOTAL_ITENS_INFORMADOS | Variável criada aqui ao agregar os dados presentes em 'QT_ITEM_EVENTO_INFORMADO' e 'VL_ITEM_EVENTO_INFORMADO', mostra o valor total de todos os itens/procedimentos adotados no atendimneto | Agregada |
Já entre as variáveis categóricas, muitas variáveis ainda podem ser aproveitadas, as variáveis de maior interesse são:
As demais variáveis são códigos de referências que deve ser obtidas em tabelas externas para trazer valor de negócio.
temp <- ifelse({names(cat_vars1) %in% det_vars}, "Detalhada", "Consolidada")
data.frame(Nome=names(cat_vars1), Descrição=cat_vars1, Tabela=temp) %>%
out_table() %>% bold(i=c(2:3, 5:8))
Nome | Descrição | Tabela |
|---|---|---|
ID_EVENTO_ATENCAO_SAUDE | Identificador único do evento de internação | Detalhada |
UF_PRESTADOR | Estado de localização do prestador do atendimento | Detalhada |
ANO_MES_EVENTO | Data da ocorrência com ano e mês | Consolidada |
CD_PROCEDIMENTO | Código de identificação do item assistencial conforme tabela externa TUSS 63 | Detalhada |
FAIXA_ETARIA | Faixa etária em que o beneficiário se encaixa | Consolidada |
SEXO | Sexo do beneficiário | Consolidada |
PORTE | Porte do prestador de plano de saúde conforme a quantidade de funcionários divulgado no útimo SIB | Consolidada |
NM_MODALIDADE | Classificação das prestadoras de planos de saúde de acordo com estatuto jurídico | Consolidada |
CID_1 | Código CID10 informado no primeiro diagnóstico | Consolidada |
CID_2 | Código CID10 informado no segundo diagnóstico (se houver) | Consolidada |
CID_3 | Código CID10 informado no terceiro diagnóstico (se houver) | Consolidada |
CID_4 | Código CID10 informado no quarto diagnóstico (se houver) | Consolidada |
Aqui, vamos ter uma noção um pouco melhor de como os dados se distribuem na amostra, as informações obtidas aqui serão úteis mais adiante na análise.
As variáveis categóricas podem oferecer algumas informações interessantes sobre as os dados que temos por aqui. Será bom lembrar que as quantidades observadas para cada valor destas variáveis está reduzida, mas por se tratar de uma amostra aleatória, as proporções devem se manter iguais ou muito próximas.
(Passe o mouse ou encoste o dedo para visualizar os valores)
temp <- aggcat_df %>%
mutate_all(order_factor) %>%
pivot_longer(cols=-ID_EVENTO_ATENCAO_SAUDE, values_to="Valor")
p <- ggplot(temp, aes(Valor)) +
geom_bar(fill=cores[6]) + coord_flip() +
facet_wrap(.~name, scales="free", ncol=2) +
labs(y=NULL, x=NULL, title="Frequência das variáveis categóricas selcionadas") +
my_ggtheme() + theme(axis.text.y=element_blank())
ggplotly(p, height=1000)
As informações que obtemos são:
Ao observar estas distribuições, algumas dúvidas surgiram:
Estas dúvidas serão sanadas mais adiante em um tópico dedicado.
Antes de qualquer coisa, é sempre bom observar as estatísticas de tendência central e de dispersão dos dados, através dela será possível chegar a algumas conclusões importantes:
temp <- na.omit(aggnum_df)
summary_num(aggnum_df, agg_numeric_vars)
Variáveis | Mínimo | Primeiro Quartil | Mediana | Média | Terceiro Quartil | Máximo | Desvio Padrão | N/Ds |
|---|---|---|---|---|---|---|---|---|
VL_TOTAL_ITENS_INFORMADOS | 0,00 | 14.599,99 | 100.569,85 | 46.664.541,03 | 879.940,35 | 413.529.821.444,63 | 2.163.608.179,17 | 4.503,00 |
VL_ITEM_PAGO_FORNECEDOR | 0,00 | 0,00 | 0,00 | 313,99 | 0,00 | 203.444,65 | 3.395,06 | 0,00 |
TEMPO_DE_PERMANENCIA | -1,00 | 1,00 | 2,00 | 6,65 | 6,00 | 1.156,00 | 21,08 | 4.503,00 |
Depois de ver estas estatísticas, além de distribuições muito assimétricas e dispersas, é possível notar a presença de outliers, que são valores anômalos que podem dificultar a nossa vida quando tentamos treinar modelos preditivos, ou simplesmente quando estamos tentando observar os dados.
Além dos outliers, em todas as variáveis numéricas, aproximadamente 4,5715% das observações não possuem nenhum valor definido, nesta seção, todas as análises serão feitas desconsiderando as mesmas, o que nos deixa com 93999 observações analisáveis em todas as variáveis.
Para encontrar os outliers será usada a técnica da Faixa Interquartil (FIQ, ou IQR na sigla em inglês), que é definido por \(IQR=Q_3-Q_1\), neste caso, \(Q_1\) e \(Q_3\) são o primeiro e o terceiro quartis, respectivamente. Este valor será usado para estabelecer um limite de valor mínimo aceitável na amostra, definido por \(L_{min}=Q_1-(1,5 \times IQR)\); e um limite de valor máximo, definido por \(L_{max}=Q_3+(1,5 \times IQR)\).
A variável “VL_TOTAL_ITENS_INFORMADOS” indica o valor total do atendimento observado. Ao retirar os outliers, tornou-se possível visualizar os dados, mas mesmo assim, é observada uma distribuição muito irregular nos dados. Para resolver este problema muitas vezes se adota uma transformação nos dados, e neste caso foi utilizado o logaritimo natural (ou logaritmo neperiano) que é uma transformação interpretável e reversível, isto significa que ainda é possível interpretar seus resultados num modelo preditivo e que esta transformação pode ser desfeita sem perder a informação original.
A única desvantagem desta transformação é a necessidade de que todos os valores sejam maiores que zero, mas como a informação desta variável trata de um valor pago em reais, é esperado que a maior parte dos valores relevantes cumpram esta condição, com exceção dos valores zero. Para contornar este problema, uma outra transformação mais simples deverá ser feita para retirar os valores zero sem perder sua informação.
a <- temp$VL_TOTAL_ITENS_INFORMADOS
# série transformada: todas as observações em seu logarítmo natural
b <- tibble(log.val=log(a+1))
# série original: apagando os outliers
a <- tibble(val=IQRsel(a))
A série original \(a\) contou apenas com a remoção de dados outiliers com valor muito alto, pois nenhuma observação se encontrava abaixo do limite mínimo de -346401, já que o valor mínimo é 0, este procedimento retirou 17,88% das observações.
Já na série transformada \(b\), cada observação \(b_i\) sofreu a transformação de acordo com seu respectivo par \(a_i\) na série original pela fórmula \(b_i=ln((a_i+1))\). Foi adotado a soma \(a_i+1\) nos valores antes de tirar o logaritmo natural por causa da presença de zeros no conjunto de dados, o número \(1\) foi adotado por que \(ln(1)=0\), logo os valores zero da distribuição original continuam valendo 0 após a transformação, enquanto as demais informações recebem seu respectivo valor exclusivo. Não foi necessário fazer nenhuma remoção de outliers após a transformação dos dados.
p1 <- ggplot(a, aes(val)) + my_ggtheme() + labs(x="a") +
geom_histogram(color=cores[6], fill=cores[6], bins=150)
p2 <- ggplot(b, aes(log.val)) + my_ggtheme() + labs(x="b") +
geom_histogram(color=cores[6], fill=cores[6], bins=150)
subplot(p1, p2, titleX=TRUE)
Observe como a distribuição muda drasticamente de formato, deixando aquele formato de ‘L’ e se tornando mais parecido com uma distribuição normal. Outra coisa que é possível perceber é que a presença de valores zero que é visível na série original \(a\) fica muito explícita após a transformação \(b\).
A variável “VL_ITEM_PAGO_FORNECEDOR” indica o valor total que o operadora (plano de saúde, seguradora, etc.) pagou diretamente para a fornecedora de serviços de saúde (hospitais, clínicas, etc.). A maior parte das informações obtidas nesta variável é de valores zero, que representam 96,01% das observações. Retirar estes dados nos deixa com apenas 3752 observações para analisar.
Com tantas observações onde o pagamento nem chega a ser feito, um modelo preditivo que tente prever esta variável teria dificuldade de chegar num valor preciso, e provavelmente apresentaria viés, subestimando os valores. Para contornar este problema, deve se observar apenas as observações com valor diferente de zero, talvez seja interessante incluir outro modelo para prever se o pagamento será necessário ou não, assim todas as necessidades de previsão se tornam satisfeitas.
a <- temp$VL_ITEM_PAGO_FORNECEDOR %>% .[.!=0]
b <- tibble(log.val=log(a+1))
a <- tibble(val=IQRsel(a))
Foram removidos 11,14% dos dados considerados outliers da série original \(a\) sem os valores zero. A série modificada \(b\) também sofreu a remoção dos valores zero, não sofreu nenhuma remoção de outlier.
p1 <- ggplot(a, aes(val)) + my_ggtheme() + labs(x="a") +
geom_histogram(color=cores[6], fill=cores[6], bins=150)
p2 <- ggplot(b, aes(log.val)) + my_ggtheme() + labs(x="b") +
geom_histogram(color=cores[6], fill=cores[6], bins=150)
subplot(p1, p2, titleX=TRUE)
Neste caso, ao aplicar a mesma transformação com logaritmo natural tem o mesmo efeito que observamos anteriormente no valor total pago dos itens e procedimentos (“VL_TOTAL_ITENS_INFORMADOS”).
A variável “TEMPO_DE_PERMANENCIA” mede o tempo de permanência no atendimento em dias, se uma pessoa é liberada no mesmo dia em que chega no hospital, o valor informado na variável será 1, se sair no dia seguinte, será 2, e assim sucessivamente. Uma característica que torna esta variável diferente das outras variáveis numéricas é o fato de ser discreta, ou seja, só aceita números inteiros.
a <- temp$TEMPO_DE_PERMANENCIA
b <- tibble(val=abs(a))
a <- tibble(val=abs(IQRsel(a)))
Foram removidos 11,29% dos dados considerados outliers, usando o método da Faixa Interquartil mencionada anteriormente. Por ser uma variável discreta com relativamente poucos valores possíveis, as transformações reversíveis normalmente não vão trazer mudanças drásticas na sua distribuição.
p1 <- ggplot(a, aes(val)) + my_ggtheme() + labs(x="Outliers removidos") +
geom_histogram(color=cores[6], fill=cores[6], bins=13)
p2 <- ggplot(b, aes(val)) + my_ggtheme() + labs(x="Original") +
geom_histogram(color=cores[6], fill=cores[6], bins=500)
subplot(p1, p2, titleX=TRUE)
A duração das internações ocorrem dentro do esperado, de maneira que as mais graves (com necessidade de mais tempo de internação) são bem menos recorrentes. Estou aproveitando que não vou aplicar nenhuma transformação nesta variável para mostrar o impacto de se remover os outliers numa variável numérica como esta; esta mudança na distribuição observada acima também ocorre nas demais variáveis numéricas vistas anteriormente.
Deve ser interessante ver como esta variável se relaciona com outras variáveis categóricas como faixa etária, e numéricas como o valor dos itens e procedimentos.
Para medir as relações entre as variáveis com a menor interferência possível, vamos criar um data frame com as variáveis numéricas e categóricas, e fazer algumas alterações para facilitar a nossa análise. Primeiramente vamos remover todos os valores faltantes e outliers da nossa amostra, e depois vamos incluir as versões transformadas que observamos anteriormente.
temp <- na.omit(agg_df)
s1 <- IQRsel(temp$VL_TOTAL_ITENS_INFORMADOS, sel=T)
s2 <- IQRsel(temp$VL_ITEM_PAGO_FORNECEDOR, sel=T)
s3 <- IQRsel(temp$TEMPO_DE_PERMANENCIA, sel=T)
tidy_df <- temp[s1 & s2 & s3,] %>%
mutate(
log.valor_item_inf = log(VL_TOTAL_ITENS_INFORMADOS+1),
log.valor_pago_forn = log(VL_ITEM_PAGO_FORNECEDOR+1),
TEMPO_DE_PERMANENCIA = abs(TEMPO_DE_PERMANENCIA))
Tirar todos os outliers de umas variáveis de um data frame pode acabar retirando também valores úteis de outras variáveis, desta maneira a perda de informação acaba indo mais longe que o desejado, dependendo da quantidade de variáveis com outliers e da quantidade de observações desta natureza ao longo de cada variável individualmente. Esta limpeza mais brusca retirou 29,91% dos dados originais, mas considerando apenas os outliers, a remoção foi de 25,62% das observações, mesmo assim, uma perda de informação maior que qualquer remoção individual de outliers feita ao longo do tópico 3.2.
Ao realizar estes cortes, uma coisa curiosa aconteceu: todos os valores de “VL_ITEM_PAGO_FORNECEDOR” agora são zero! Tínhamos observado antes que existia uma permanência muito grande de valores zero, e depois de fazer esta limpeza, já temos o primeiro insight: A ocorrência de valores diferentes de zero nesta variável pode estar associada com a presença de outlier(s) de outra(s) variável(eis); isto quer dizer que estas transferências diretas do seguro/plano de saúde para operadora de saúde estão relacionadas ao caso extremo em alguma outra variável, como valor dos procedimentos e/ou tempo de permanência.
Vamos começar a investigar as correlações por essa possível correlação que encontramos aqui:
Para observar esta variável vamos ter que fazer um corte diferente das demais. Já que existem muitos valores iguais a zero, vamos pegar apenas os diferentes de zero, e depois vamos dar uma olhada em como a presença destes valores se distribui ao longo das variáveis categóricas:
temp <- agg_df[agg_df$VL_ITEM_PAGO_FORNECEDOR > 0,]
temp <- temp %>%
mutate_all(order_factor) %>%
pivot_longer(
cols=c(SEXO, FAIXA_ETARIA, PORTE, NM_MODALIDADE,
UF_PRESTADOR, ANO_MES_EVENTO),
values_to="Valor")
p <- ggplot(temp, aes(Valor)) +
geom_bar(fill=cores[6]) + coord_flip() +
facet_wrap(.~name, scales="free", ncol=2) +
labs(
y=NULL, x=NULL,
title="Frequência das variáveis categóricas onde o valor<br>pago ao fornecedor é maior que zero") +
my_ggtheme() + theme(axis.text.y=element_blank())
ggplotly(p, height=900) %>% layout(margin=list(t=150))
A distribuição dessas variáveis se difere da que já observamos antes quando não fizemos recortes nos dados. Já vimos aqui como o valor pago ao fornecedor se distribui originalmente ao longo de todas as observações, e a primeira coisa que dá para perceber é a ausência de informações em boa parte das ocorrências em que essa variável tem valor maior que zero.
Nos casos em que há informação, as mudanças mais perceptíveis que obtemos está na faixa etária, onde há uma maior concentração de ocorrências está na faixa dos 30 à 39 anos de idade e entre os idosos, enquanto que neste recorte existe uma concentração entre os adultos de todas as idades; outra grande mudança é regional, a maioria das ocorrências estavam nos estados mais populosos do país, mas neste recorte as ocorrências se concentram primeiramente nos estados mais populosos do nordeste.
Não será necessário repetir este procedimento para as outras variáveis numéricas, por que nenhuma das outras possui um número de valores zero e faltantes quanto esta. Agora podemos fazer uma análise entre as variáveis numéricas, mas antes de colocar a mão na massa, devemos lembrar das distribuições das variáveis numéricas que observamos anteriormente. A amostra que temos do “valor pago ao fornecedor” e do “valor dos procedimentos” contém observações muito erráticas mesmo depois da remoção de outliers, portanto, o que vamos fazer é comparar suas versões transformadas por logaritmos que também observamos anteriormente.
temp <- agg_df %>% na.omit() %>%
.[.$VL_ITEM_PAGO_FORNECEDOR > 0,] %>%
mutate(log.vl_itens=log(VL_TOTAL_ITENS_INFORMADOS+1),
log.vl_pago=log(VL_ITEM_PAGO_FORNECEDOR+1))
p <- ggplot(temp, aes(log.vl_pago, log.vl_itens)) +
geom_point(color=cores[6], alpha=0.2) +
geom_smooth(method="lm", formula=y~x, se=F, color=cores[6]) +
labs(
x="Logaritmo natural do valor pago ao fornecedor",
y="Logaritmo natural do valor dos \nitens e procedimentos") +
my_ggtheme()
ggplotly(p)
Este resultado é muito interessante! Aparentemente, o valor pago ao fornecedor está correlacionado com o valor dos procedimentos, numa escala de 0 a 1, o coeficiente de correlação entre eles é de 0.6378452, o que significa que valores maiores dos itens e procedimentos está geralmente relacionado à valores maiores pagos ao fornecedor. Mas é importante lembrar que só observamos esta correlação após transformar as variáveis, e mais importante, depois de tirar várias observações onde o valor pago ao fornecedor é zero, desfazer qualquer uma destas alterações certamente diminuiria o nível de correlação entre elas.
Depois de vasculhar as demais variáveis, temos o poder de definir as que mais poderiam ajudar a prever a necessidade de um fornecedor pagar, ou até mesmo qual valor seria pago. Uma simples regressão linear (linha reta no gráfico acima) já consegue representar bem a relação entre estas variáveis.
Também dá pra perceber algumas aglomerações curiosas: Uma maior, que está mais inclinada que a reta de regressão, uma pequena que aparenta estar mais horizontalizada que reta da regressão simples, além de alguns dados dispersos que parecem apresentar pouca ou nenhuma correlação entre si no canto superior esquerdo.
Separar estes três grupos que percebemos em conjuntos diferentes pode ajudar a tornar a previsão ainda mais precisa, alguns modelos de previsão podem ser usados para fazer esta separação de maneira dinâmica e automática, sem demandar atenção constante de uma pessoa conforme novos dados forem adicionados.
Seria possível esperar que valores maiores gastos em itens e procedimentos no atendimento estejam relacionados a tempos maiores de internação. Neste gráfico abaixo nós podemos ver como estas variáveis se relacionam na prática:
p <- ggplot(tidy_df, aes(log.valor_item_inf, TEMPO_DE_PERMANENCIA)) +
geom_point(alpha=1/20, color=cores[6]) + my_ggtheme() +
labs(y=NULL, x="Logarítmo natural do \nvalor total dos procedimentos")
g <- ggplot(tidy_df, aes(VL_TOTAL_ITENS_INFORMADOS, TEMPO_DE_PERMANENCIA)) +
geom_point(alpha=1/20, color=cores[6]) + my_ggtheme() +
labs(y="Tempo de permanência (dias)", x="Valor total dos procedimentos\n")
ggpubr::ggarrange(g, p, nrow=1)
Pelo que podemos ver nos gráficos, existe uma mudança na variância dos valores totais para cada tempo de permanência, explico: podemos ver que qualquer valor é possível nos procedimentos quando o tempo de permanência é igual á 1 dia, mas as possibilidades vão se estreitando conforme o tempo de permanência vai aumentando, na estatística, este comportamento é chamado de (alerta de palavrão) heterocedasticidade.
Quando olhamos para os coeficientes de correlação do tempo de permanência contra o valor dos procedimentos (0,2566) e contra o logaritmo natural da mesma variável (0,1990) são ambos positivos, mas a impressão que temos pelos gráficos é de que estas correlações deveriam apresentar valores negativos e positivos respectivamente. Este é um efeito da heterocedasticidade, quando temos variâncias inconsistentes entre duas variáveis, algumas dessas métricas passam a ser pouco confiáveis.
Agora vamos poder descobrir que variáveis categóricas descrevem melhor as pessoas que passam mais tempo internadas, e consequentemente o caso oposto também.
Existe uma presença maior de homens entre os que ficam internados por mais dias.
p <- ggplot(tidy_df, aes(y=TEMPO_DE_PERMANENCIA, x=SEXO)) +
geom_boxplot(fill=cores[6], outlier.color=cores[3], color=cores[3]) +
my_ggtheme() + xlab(NULL) + coord_flip()
ggplotly(p)
Como esperado, as idades maiores estão mais relacionadas à maior tempo de internação, os requisitos mencionados anteriormente podem estar relacionados com a adoção de preços significativamente mais altos para clientes com idades mais altas. Curiosamente os infantes com idade menor que 5 anos também estão entre os que passam mais tempo internados.
p <- ggplot(tidy_df, aes(y=TEMPO_DE_PERMANENCIA, x=FAIXA_ETARIA)) +
geom_boxplot(fill=cores[6], color=cores[3]) +
my_ggtheme() + xlab(NULL) + coord_flip()
ggplotly(p)
As variáveis mais indicadas para alimentar um modelo de previsão já foram discutidas anteriormente. Agora estas variáveis serão agregadas por internação e separadas em dois grupos: um para treinamento dos modelos e outro para avaliar a qualidade das previsões. O grupo de treinamento será uma amostra aleatória contendo 80% dos dados disponíveis, enquanto que os dados de avaliação serão os demais 20% dos dados que não foram incluídos no grupo de treinamento.
Os principais negócios interessados no valor deste conjunto de dados seriam as empresas seguradoras de saúde, estas estariam principalmente em prever se haveria necessidade de transferir algum recurso para a fornecedora de saúde. Para isso, vamos adicionar uma variável-alvo que represente o evento de acionamento do seguro.
# Criando variavel target
df$ACIONAMENTO_DO_SEGURO <- df$VL_ITEM_PAGO_FORNECEDOR > 0
# Obtendo informações sobre o balanceamento dos dados
QTD_ACIONAMENTOS <- sum(df$ACIONAMENTO_DO_SEGURO)
QTD_CASOS <- nrow(df)
A próxima etapa é escolher as variáveis que podem ajudar nosso modelo preditivo a chegar na resposta esperada com tempestividade. Mas apenas depois que obtivermos um conjunto de dados balanceados, pois apenas 2.28% das ocorreências registradas apresentam acionamento de seguro, para evitar vieses, o efeito da simples quantidade de observações não pode ser maior que a presença das variáveis explicativas.
# Obtendo indices de `df`
df_index <- row.names(df) %>% as.numeric()
# Obtendo indices das amostras balanceadas
### maximizando a quantidade de observações usando todos os casos positivos
negative_sample_index <- sample(x=df_index[!df$ACIONAMENTO_DO_SEGURO], size=QTD_ACIONAMENTOS)
positive_index <- df_index[df$ACIONAMENTO_DO_SEGURO]
mdl1_index <- c(negative_sample_index, positive_index)
# Selecionando variáveis úteis
mdl1_cols <- c("NM_MODALIDADE", "UF_PRESTADOR", "FAIXA_ETARIA", "ANO_MES_EVENTO")
# Criando novo dataframe com valores de "ACIONAMENTO_DO_SEGURO" balanceados
mdl1_df <- df[mdl1_index, mdl1_cols]
Já aprendemos anteriormente como estas variáveis categóricas se relacionam com o acionamento do seguro, o objetivo desta engenharia de variáveis é